home *** CD-ROM | disk | FTP | other *** search
/ NOVA - For the NeXT Workstation / NOVA - For the NeXT Workstation.iso / Documents / NeXTAnswers / mathematica.360 < prev    next >
Text File  |  1992-02-06  |  12KB  |  583 lines
  1. Mathematica CallProcess linkage code
  2.  
  3. Q:  What's the linkage code necessary for communicating with Mathematica using CallProcess?
  4.  
  5. A:   Create the following two files.  
  6. (1) A file named mathlink.h, which is empty.
  7. (2) A file named mathlink.c, consisting of the following:
  8.  
  9. #
  10.  
  11. /**  External Functions for Use with CallProcess  **/
  12.  
  13. /* Copyright 1988 Wolfram Research, Inc. */
  14.  
  15.  
  16. #include    <stdio.h>
  17. #include    <varargs.h>
  18. #include    <strings.h>
  19.  
  20. /* NB:  We assume that the following file descriptors are used for comunication
  21.     between mathematica and the user program:
  22.         0  :  Read pipe for program
  23.         1  :  Write pipe to math
  24. */
  25. #define    ERROR        -1
  26. #define    FALSE        0
  27. #define    TRUE        1
  28.  
  29. #define    MATHREADPID    0
  30. #define    MATHWRITEPID    1
  31. #define    PKTSIZE        64
  32. #define    BUFSIZE        (PKTSIZE * 10)
  33. #define    MAXARGSIZE    128
  34.  
  35.     /* Buffer Identifiers */
  36. #define    IDENT_MAGIC    '0'
  37. #define    IDENT_REQUEST    '1'
  38. #define    IDENT_RESULT    '2'
  39. #define    IDENT_INSTALL    '3'
  40. #define    IDENT_CALL    '4'
  41. #define    IDENT_ERROR    '5'
  42. #define    IDENT_START    '6'
  43. #define    IDENT_KILL    '7'
  44.  
  45.     /* Types (this corresponds to type table (typetab) below) */
  46. #define    T_INT        1
  47. #define    T_DOUBLE    2
  48. #define    T_CHARSTAR    3
  49.  
  50.     /* Function Table */
  51. struct FTABENT {
  52.     void        (*ft_func)();        /* The function to call */
  53.     char        *ft_name;        /* The functions name */
  54.     unsigned char    ft_ftype;        /* The functions type */
  55.     struct FALIST    *ft_falist;        /* The functions argument list */
  56.     struct FTABENT    *ft_nxt;        /* Pointer to next ftab */
  57. };
  58.  
  59. struct FALIST {
  60. /*    char        *fa_name;        /* Argument name */
  61.     unsigned char    fa_atype;        /* Argument type */
  62.     struct FALIST    *fa_nxt;        /* Pointer to next argument */
  63. };
  64.  
  65. static char *typetab[] = {"", "int", "double", "char *", NULL};
  66.  
  67. static struct FTABENT *ftabbase    = NULL;
  68.  
  69. MathInit() {
  70.  
  71.     sendbuf(IDENT_MAGIC,"MathLinkedFile");
  72. }
  73.  
  74.  
  75. MathExec(cp)
  76. register char *cp; {
  77.  
  78.     sendbuf(IDENT_REQUEST,cp);
  79. }
  80.  
  81.  
  82.  
  83. MathInstall(func,fname,ftype,argnames,argtypes)
  84. void (*func)();
  85. char *fname;
  86. char *ftype;
  87. char *argnames;
  88. char *argtypes; {
  89.     register struct FTABENT *ftp;
  90.     register struct FALIST *fap;
  91.     register char *cp;
  92.     char *cp1;
  93.     int i = 0;
  94.     char instbuf[BUFSIZE];
  95.     static char *getcsfield();
  96.  
  97.     if ((ftp = (struct FTABENT *)malloc(sizeof *ftp)) == NULL) {
  98.         /* Return Error */
  99.     }
  100.     ftp->ft_nxt = ftabbase;
  101.     ftabbase = ftp;
  102.     ftp->ft_func = func;
  103.     ftp->ft_name = fname;
  104.     if (!(ftp->ft_ftype = typelookup(ftype)))
  105.         return(FALSE);
  106.     outtypename(&i,instbuf,ftype,fname);
  107.     ftp->ft_falist = NULL;
  108.     while (cp = getcsfield(&argnames)) {
  109.         if ((fap = (struct FALIST *)malloc(sizeof *fap)) == NULL) {
  110.             /* Return Error */
  111.         }
  112.         fap->fa_nxt = ftp->ft_falist;
  113.         ftp->ft_falist = fap;
  114.         cp1 = cp;
  115.         while (*cp != '\0' && *cp != '_')
  116.             cp++;
  117.         if (*cp == '\0')
  118.             outtypename(&i,instbuf,"",cp1);
  119.         else {
  120.             *cp++ = '\0';
  121.             outtypename(&i,instbuf,cp,cp1);
  122.         }
  123.         if (!(cp = getcsfield(&argtypes))) {
  124.             /* Return Error */
  125.         }
  126.         if (!(fap->fa_atype = typelookup(cp))) {
  127.             /* Return Error */
  128.         }
  129.     }
  130.     instbuf[i] = '\0';
  131.     sendbuf(IDENT_INSTALL,instbuf);
  132.     /* Return No Error */
  133. }
  134.  
  135.  
  136.  
  137. MathStart() {
  138.  
  139.     sendbuf(IDENT_START,"");
  140.     service_loop();
  141. }
  142.  
  143.  
  144.  
  145. static char *
  146. getcsfield(cpp)
  147. register char **cpp; {
  148.     register char *cp,*rcp;
  149.  
  150.     cp = *cpp;
  151.     while (*cp == ' ')
  152.         cp++;
  153.     rcp = cp;
  154.     if (*rcp == '\0' || *cp == ',')
  155.         return(NULL);
  156.     while (*cp != ',' && *cp != '\0')
  157.         cp++;
  158.     while (*(cp-1) == ' ')
  159.         cp--;
  160.     if (*cp != '\0')
  161.         *cp++ = '\0';
  162.     while (*cp == ',' || *cp == ' ')
  163.         cp++;
  164.     *cpp = cp;
  165.     return(rcp);
  166. }
  167.  
  168.  
  169. static
  170. typelookup(cp)
  171. register char *cp; {
  172.     register int i;
  173.  
  174.     for (i=0;typetab[i] != NULL;i++)
  175.         if (strcmp(typetab[i],cp) == 0)
  176.             return(i);
  177.     return(FALSE);
  178. }
  179.  
  180.  
  181.  
  182. static
  183. service_loop() {
  184.     register int i;
  185.     register int bfsize;
  186.     char inbuf[BUFSIZE];
  187.  
  188.     while (TRUE) {
  189.         rcvpkt(inbuf);
  190.         bfsize = atoi(inbuf);
  191.         for (i=1;i<(bfsize + PKTSIZE - 1)/PKTSIZE;i++)
  192.             rcvpkt(&inbuf[i * PKTSIZE]);
  193.         switch (inbuf[5]) {
  194.             case IDENT_CALL:
  195.                 docall(&inbuf[7]);
  196.                 break;
  197.             case IDENT_KILL:
  198.                 exit(0);
  199.             default:
  200.                 ;
  201.                 /* Handle Error */
  202.         }
  203.     }
  204. }
  205.  
  206.  
  207.  
  208. static
  209. rcvpkt(pktp)
  210. register char *pktp; {
  211.  
  212.     if (read(MATHREADPID,pktp,PKTSIZE) != PKTSIZE) {
  213.         /* Handle Error */
  214.         exit(1);
  215.     }
  216. }
  217.  
  218. static
  219. sendbuf(bftype,pbuf)
  220. char bftype;
  221. char *pbuf; {
  222.     register int i;
  223.     register int bfsize;
  224.     char outbuf[BUFSIZE];
  225.  
  226.           /* buf_date     + nl + bfsize + nl + bfident + nl */
  227.     bfsize = strlen(pbuf) + 1  + 4      + 1  + 1       + 1;
  228.     if (bfsize >= sizeof outbuf) {
  229.         /* Handle Error */
  230.         exit(1);
  231.     }
  232.     sprintf(outbuf,"%4d\n%c\n%s\n",bfsize,bftype,pbuf);
  233.     for (i=0;i<(bfsize + PKTSIZE - 1)/PKTSIZE;i++)
  234.         sendpkt(&outbuf[i * PKTSIZE]);
  235. }
  236.  
  237.  
  238. static
  239. sendpkt(pktp)
  240. register char *pktp; {
  241.  
  242.     if (write(MATHWRITEPID,pktp,PKTSIZE) != PKTSIZE) {
  243.         /* Handle Error */
  244.         exit(1);
  245.     }
  246. }
  247.  
  248.  
  249.  
  250. static
  251. docall(bp)
  252. char *bp; {
  253.     register struct FTABENT *ftp;
  254.     register struct FALIST *fap;
  255.     register char *cp;
  256.     int argtplate;
  257.     char result[128];
  258.     int aidx = 0;
  259.     struct {char argv[MAXARGSIZE];} ags;
  260.     int *t_ip;  double *t_dp;  char **t_cpp;
  261.     int t_i;  double t_d;  char *t_cp;
  262.     static char *getword();
  263.     static struct FTABENT *ftablookup();
  264.     extern double atof();
  265.  
  266.     cp = getword(&bp);
  267.     if ((ftp = ftablookup(cp)) == NULL) {
  268.         /* Handle Error */
  269.         exit(1);
  270.     }
  271.     for (fap = ftp->ft_falist,argtplate=0;fap != NULL;fap = fap->fa_nxt) {
  272.         argtplate = 10*argtplate + fap->fa_atype;
  273.         switch (fap->fa_atype) {
  274.             case T_INT:
  275.                 t_ip = (int *)&(ags.argv[aidx]);
  276.                 aidx += sizeof (*t_ip);
  277.                 *t_ip = atoi(getword(&bp));
  278.                 break;
  279.             case T_DOUBLE:
  280.                 t_dp = (double *)&(ags.argv[aidx]);
  281.                 aidx += sizeof (*t_dp);
  282.                 *t_dp = atof(getword(&bp));
  283.                 break;
  284.             case T_CHARSTAR:
  285.                 t_cpp = (char **)&(ags.argv[aidx]);
  286.                 aidx += sizeof (*t_cpp);
  287.                 *t_cpp = getword(&bp);
  288.                 break;
  289.         }
  290.     }
  291.     switch (ftp->ft_ftype) {
  292.         case T_INT:
  293.             switch (argtplate) {
  294.             case T_INT:
  295.                 t_i = (* (int (*)())ftp->ft_func)(
  296.                         (*(int *)(&(ags.argv[0])))
  297.                         );
  298.                 break;
  299.             case T_DOUBLE:
  300.                 t_i = (* (int (*)())ftp->ft_func)(
  301.                         (*(double *)(&(ags.argv[0])))
  302.                         );
  303.                 break;
  304.             case T_CHARSTAR:
  305.                 t_i = (* (int (*)())ftp->ft_func)(
  306.                         (*(char **)(&(ags.argv[0])))
  307.                         );
  308.                 break;
  309.             case 10*T_INT+T_INT:
  310.                 t_i = (* (int (*)())ftp->ft_func)(
  311.                         (*(int *)(&(ags.argv[0]))),
  312.                         (*(int *)(&(ags.argv[4])))
  313.                         );
  314.                 break;
  315.             case 10*T_INT+T_DOUBLE:
  316.                 t_i = (* (int (*)())ftp->ft_func)(
  317.                         (*(int *)(&(ags.argv[0]))),
  318.                         (*(double *)(&(ags.argv[4])))
  319.                         );
  320.                 break;
  321.             case 10*T_INT+T_CHARSTAR:
  322.                 t_i = (* (int (*)())ftp->ft_func)(
  323.                         (*(int *)(&(ags.argv[0]))),
  324.                         (*(char **)(&(ags.argv[4])))
  325.                         );
  326.                 break;
  327.             case 10*T_DOUBLE+T_INT:
  328.                 t_i = (* (int (*)())ftp->ft_func)(
  329.                         (*(double *)(&(ags.argv[0]))),
  330.                         (*(int *)(&(ags.argv[8])))
  331.                         );
  332.                 break;
  333.             case 10*T_DOUBLE+T_DOUBLE:
  334.                 t_i = (* (int (*)())ftp->ft_func)(
  335.                         (*(double *)(&(ags.argv[0]))),
  336.                         (*(double *)(&(ags.argv[8])))
  337.                         );
  338.                 break;
  339.             case 10*T_DOUBLE+T_CHARSTAR:
  340.                 t_i = (* (int (*)())ftp->ft_func)(
  341.                         (*(double *)(&(ags.argv[0]))),
  342.                         (*(char **)(&(ags.argv[8])))
  343.                         );
  344.                 break;
  345.             case 10*T_CHARSTAR+T_INT:
  346.                 t_i = (* (int (*)())ftp->ft_func)(
  347.                         (*(char **)(&(ags.argv[0]))),
  348.                         (*(int *)(&(ags.argv[4])))
  349.                         );
  350.                 break;
  351.             case 10*T_CHARSTAR+T_DOUBLE:
  352.                 t_i = (* (int (*)())ftp->ft_func)(
  353.                         (*(char **)(&(ags.argv[0]))),
  354.                         (*(double *)(&(ags.argv[4])))
  355.                         );
  356.                 break;
  357.             case 10*T_CHARSTAR+T_CHARSTAR:
  358.                 t_i = (* (int (*)())ftp->ft_func)(
  359.                         (*(char **)(&(ags.argv[0]))),
  360.                         (*(char **)(&(ags.argv[4])))
  361.                         );
  362.                 break;
  363.             }
  364.             sprintf(result,"%d\n",t_i);
  365.             break;
  366.         case T_DOUBLE:
  367.             switch (argtplate) {
  368.             case T_INT:
  369.                 t_d = (* (double (*)())ftp->ft_func)(
  370.                         (*(int *)(&(ags.argv[0])))
  371.                         );
  372.                 break;
  373.             case T_DOUBLE:
  374.                 t_d = (* (double (*)())ftp->ft_func)(
  375.                         (*(double *)(&(ags.argv[0])))
  376.                         );
  377.                 break;
  378.             case T_CHARSTAR:
  379.                 t_d = (* (double (*)())ftp->ft_func)(
  380.                         (*(char **)(&(ags.argv[0])))
  381.                         );
  382.                 break;
  383.             case 10*T_INT+T_INT:
  384.                 t_d = (* (double (*)())ftp->ft_func)(
  385.                         (*(int *)(&(ags.argv[0]))),
  386.                         (*(int *)(&(ags.argv[4])))
  387.                         );
  388.                 break;
  389.             case 10*T_INT+T_DOUBLE:
  390.                 t_d = (* (double (*)())ftp->ft_func)(
  391.                         (*(int *)(&(ags.argv[0]))),
  392.                         (*(double *)(&(ags.argv[4])))
  393.                         );
  394.                 break;
  395.             case 10*T_INT+T_CHARSTAR:
  396.                 t_d = (* (double (*)())ftp->ft_func)(
  397.                         (*(int *)(&(ags.argv[0]))),
  398.                         (*(char **)(&(ags.argv[4])))
  399.                         );
  400.                 break;
  401.             case 10*T_DOUBLE+T_INT:
  402.                 t_d = (* (double (*)())ftp->ft_func)(
  403.                         (*(double *)(&(ags.argv[0]))),
  404.                         (*(int *)(&(ags.argv[8])))
  405.                         );
  406.                 break;
  407.             case 10*T_DOUBLE+T_DOUBLE:
  408.                 t_d = (* (double (*)())ftp->ft_func)(
  409.                         (*(double *)(&(ags.argv[0]))),
  410.                         (*(double *)(&(ags.argv[8])))
  411.                         );
  412.                 break;
  413.             case 10*T_DOUBLE+T_CHARSTAR:
  414.                 t_d = (* (double (*)())ftp->ft_func)(
  415.                         (*(double *)(&(ags.argv[0]))),
  416.                         (*(char **)(&(ags.argv[8])))
  417.                         );
  418.                 break;
  419.             case 10*T_CHARSTAR+T_INT:
  420.                 t_d = (* (double (*)())ftp->ft_func)(
  421.                         (*(char **)(&(ags.argv[0]))),
  422.                         (*(int *)(&(ags.argv[4])))
  423.                         );
  424.                 break;
  425.             case 10*T_CHARSTAR+T_DOUBLE:
  426.                 t_d = (* (double (*)())ftp->ft_func)(
  427.                         (*(char **)(&(ags.argv[0]))),
  428.                         (*(double *)(&(ags.argv[4])))
  429.                         );
  430.                 break;
  431.             case 10*T_CHARSTAR+T_CHARSTAR:
  432.                 t_d = (* (double (*)())ftp->ft_func)(
  433.                         (*(char **)(&(ags.argv[0]))),
  434.                         (*(char **)(&(ags.argv[4])))
  435.                         );
  436.                 break;
  437.             }
  438.             sprintf(result,"%f\n",t_d);
  439.             break;
  440.         case T_CHARSTAR:
  441.             switch (argtplate) {
  442.             case T_INT:
  443.                 t_cp = (* (char * (*)())ftp->ft_func)(
  444.                         (*(int *)(&(ags.argv[0])))
  445.                         );
  446.                 break;
  447.             case T_DOUBLE:
  448.                 t_cp = (* (char * (*)())ftp->ft_func)(
  449.                         (*(double *)(&(ags.argv[0])))
  450.                         );
  451.                 break;
  452.             case T_CHARSTAR:
  453.                 t_cp = (* (char * (*)())ftp->ft_func)(
  454.                         (*(char **)(&(ags.argv[0])))
  455.                         );
  456.                 break;
  457.             case 10*T_INT+T_INT:
  458.                 t_cp = (* (char * (*)())ftp->ft_func)(
  459.                         (*(int *)(&(ags.argv[0]))),
  460.                         (*(int *)(&(ags.argv[4])))
  461.                         );
  462.                 break;
  463.             case 10*T_INT+T_DOUBLE:
  464.                 t_cp = (* (char * (*)())ftp->ft_func)(
  465.                         (*(int *)(&(ags.argv[0]))),
  466.                         (*(double *)(&(ags.argv[4])))
  467.                         );
  468.                 break;
  469.             case 10*T_INT+T_CHARSTAR:
  470.                 t_cp = (* (char * (*)())ftp->ft_func)(
  471.                         (*(int *)(&(ags.argv[0]))),
  472.                         (*(char **)(&(ags.argv[4])))
  473.                         );
  474.                 break;
  475.             case 10*T_DOUBLE+T_INT:
  476.                 t_cp = (* (char * (*)())ftp->ft_func)(
  477.                         (*(double *)(&(ags.argv[0]))),
  478.                         (*(int *)(&(ags.argv[8])))
  479.                         );
  480.                 break;
  481.             case 10*T_DOUBLE+T_DOUBLE:
  482.                 t_cp = (* (char * (*)())ftp->ft_func)(
  483.                         (*(double *)(&(ags.argv[0]))),
  484.                         (*(double *)(&(ags.argv[8])))
  485.                         );
  486.                 break;
  487.             case 10*T_DOUBLE+T_CHARSTAR:
  488.                 t_cp = (* (char * (*)())ftp->ft_func)(
  489.                         (*(double *)(&(ags.argv[0]))),
  490.                         (*(char **)(&(ags.argv[8])))
  491.                         );
  492.                 break;
  493.             case 10*T_CHARSTAR+T_INT:
  494.                 t_cp = (* (char * (*)())ftp->ft_func)(
  495.                         (*(char **)(&(ags.argv[0]))),
  496.                         (*(int *)(&(ags.argv[4])))
  497.                         );
  498.                 break;
  499.             case 10*T_CHARSTAR+T_DOUBLE:
  500.                 t_cp = (* (char * (*)())ftp->ft_func)(
  501.                         (*(char **)(&(ags.argv[0]))),
  502.                         (*(double *)(&(ags.argv[4])))
  503.                         );
  504.                 break;
  505.             case 10*T_CHARSTAR+T_CHARSTAR:
  506.                 t_cp = (* (char * (*)())ftp->ft_func)(
  507.                         (*(char **)(&(ags.argv[0]))),
  508.                         (*(char **)(&(ags.argv[4])))
  509.                         );
  510.                 break;
  511.             }
  512.             sprintf(result,"%s\n",t_cp);
  513.             break;
  514.     }
  515.     sendbuf(IDENT_RESULT,result);
  516. }
  517.  
  518.  
  519.  
  520. static
  521. putinbuf(bp,buf,cp)
  522. register int *bp;
  523. register char *buf,*cp; {
  524.     register int i;
  525.  
  526.     if (*bp + (i = strlen(cp)) >= BUFSIZE) {
  527.         /* Handle Error */
  528.         exit(1);
  529.     }
  530.     strcpy(&buf[*bp],cp);
  531.     *bp += i;
  532. }
  533.  
  534.  
  535.  
  536. static
  537. outtypename(bp,buf,type,name)
  538. register int *bp;
  539. register char *buf;
  540. register char *type;
  541. register char *name; {
  542.  
  543.     putinbuf(bp,buf,type);
  544.     putinbuf(bp,buf,"\n");
  545.     putinbuf(bp,buf,name);
  546.     putinbuf(bp,buf,"\n");
  547. }
  548.  
  549.  
  550.  
  551. static char *
  552. getword(cp)
  553. register char **cp; {
  554.     register char *sp,*cp1;
  555.  
  556.     sp = cp1 = *cp;
  557.     for (;*cp1 != '\0' && *cp1 != '\n';cp1++);
  558.     if (cp1 != '\0') 
  559.         *cp1++ = '\0';
  560.     *cp = cp1;
  561.     return(sp);
  562. }
  563.  
  564.  
  565.  
  566. static struct FTABENT *
  567. ftablookup(cp)
  568. register char *cp; {
  569.     register struct FTABENT *ftp;
  570.  
  571.     for (ftp=ftabbase;ftp != NULL;ftp = ftp->ft_nxt)
  572.         if (strcmp(cp,ftp->ft_name) == 0)
  573.             return(ftp);
  574.     return(NULL);
  575. }
  576.  
  577. QA360                
  578.  
  579. Valid for 1.0 
  580. Not checked yet for 2.0 
  581.  
  582.  
  583.